home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d4 / iq.arc / IQ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-11-13  |  5.1 KB  |  102 lines
  1. 10  WIDTH 80:KEY OFF:SCREEN 0,1,0:KEY(10) ON:ON KEY(10) GOSUB 570:COLOR 3,0,8
  2. 20  R$=STRING$(79,205):S$=STRING$(79,196):CLS
  3. 30  PRINT "VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR
  4. 40  PRINT "CALLThe 16 programs which make up this IQ system were created by an    CALL
  5. 50  PRINT "CALLunknown author and placed on the Sears Bulletin Board System. The  CALL
  6. 60  PRINT "CALLprograms were completely overhauled during September, 1985 by:     CALL
  7. 70  PRINT "CALL                                                                   CALL
  8. 80  PRINT "CALL                    Personal Data Services, Inc.                   CALL
  9. 90  PRINT "CALL                    35622 4th Ave. S.W.                            CALL
  10. 100  PRINT"CALL                    Federal Way, Wa 98003                          CALL
  11. 110  PRINT"CALL                    Compuserv [71350,1711]                         CALL
  12. 120  PRINT"CALL                                                                   CALL
  13. 130  PRINT"CALLBASICA is required. The system will run on any combination of colorCALL
  14. 140  PRINT"CALLgraphics/monochrome boards, with color and/or monochrome monitors. CALL
  15. 150  PRINT"CALL                                                                   CALL
  16. 160  PRINT"CALLAll of the programs have been made free-standing (they can be run  CALL
  17. 170  PRINT"CALLindependently). All words have been run thru a dictionary check.   CALL
  18. 180  PRINT"CALLFollowing is a listing of the other programs in the IQ system:     CALL
  19. 190  PRINT"CALL                                                                   CALL
  20. 200  PRINT"CALLANALOGY1.BAS  4447  ANALOGY6.BAS  4658  NUMBERS1.BAS  5754         CALL
  21. 210  PRINT"CALLANALOGY2.BAS  4438  ANTONYM1.BAS  4435  NUMBERS2.BAS  4324         CALL
  22. 220  PRINT"CALLANALOGY3.BAS  4556  ANTONYM2.BAS  4738  NUMBERS3.BAS  4333         CALL
  23. 230  PRINT"CALLANALOGY4.BAS  4227  IQ      .BAS  5212  SYNONYM1.BAS  4519         CALL
  24. 240  PRINT"CALLANALOGY5.BAS  4298  IQ      .SAV   384  SYNONYM2.BAS  4777         CALL
  25. 250  PRINT"CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'
  26. 260  COLOR 0,3:LOCATE 25,1:PRINT"Press space bar to continue.";
  27. 270  IN$=INKEY$:IF IN$="" THEN 270
  28. 280  WIDTH 80:KEY OFF:SCREEN 0,1,0:COLOR 7,0,8
  29. 290  R$=STRING$(79,205):S$=STRING$(79,196)
  30. 300  DEF SEG=&H40:POKE &H17,0:DEF SEG  'Insure num lock off from games
  31. 310  ON ERROR GOTO 950:DIM A$(20)
  32. 320  OPEN "IQ.SAV" FOR INPUT AS #1
  33. 330  FOR I=1 TO 20
  34. 340    INPUT #1,A$(I)
  35. 350  NEXT I:CLOSE #1:
  36. 360  CLS:COLOR 4,0:LOCATE ,32:PRINT"BASICA required!"
  37. 370  COLOR 2,0:PRINT R$
  38. 380  PRINT "To return to this menu from a running program, use <F10>. If not in BASICA"
  39. 390  PRINT"command level when return is desired, enter Ctrl/Break; then press <F10>.":PRINT R$
  40. 400  GOSUB 730
  41. 410  KEY 10, "RUN"+CHR$(34)+"IQ"+CHR$(13)
  42. 420  COLOR 6,0:PRINT S$:PRINT "  a. Enter 1 thru 20 to run the program from the menu -- OR
  43. 430  PRINT "  b. Enter 96 if entry is to be added, changed or deleted. -- OR
  44. 440  PRINT "  c. Enter 97 if new menu is to be built -- OR "
  45. 450  PRINT "  d. Enter 98 if return to BASIC prompt is desired -- OR"
  46. 460  PRINT "  e. Enter 99 if return to DOS prompt is desired."
  47. 470  PRINT S$:COLOR 2,0:INPUT "Which of the listed programs or options do you want" ;S
  48. 480  IF S<1 OR (S>20 AND S<96) OR S>99 THEN GOTO 540
  49. 490  IF S=96 THEN CLS:PRINT S$:GOSUB 730:GOTO 580
  50. 500  IF S=98 THEN GOTO 550
  51. 510  IF S=99 THEN GOTO 560
  52. 520  IF S=97 GOTO 770
  53. 530  IF LEN(A$(S))=0 OR LEN(A$(S))>8 GOTO 540 ELSE CLS:COLOR 7,0:RUN A$(S)
  54. 540  CLS:COLOR 20,0:PRINT "Program";S;"**ERROR** (Invalid program name or number) - Check and correct.":COLOR 2,0:PRINT S$:GOTO 380
  55. 550  CLS:END        'Here if menu select was 98 - return to BASIC
  56. 560  CLS:SYSTEM     'Here if menu select was 99 - return to DOS
  57. 570  SYSTEM
  58. 580  COLOR 7,0:PRINT S$: INPUT "Enter line number of item to be altered - ",T:IF T>20 THEN GOTO 580
  59. 590  DEF SEG=&H40:POKE &H17,PEEK(&H17) OR &H40:DEF SEG     'Caps lock ON
  60. 600  PRINT S$:PRINT "Enter program name to be inserted in above line."
  61. 610  COLOR 6,0:PRINT "(Press <ENTER> with no program name entered to delete current program.)":COLOR 7,0:PRINT S$:COLOR 2,0:INPUT"",T$:COLOR 7,0:PRINT S$
  62. 620  IF LEN(T$)>8 THEN T$="*ENTRY ERROR*"
  63. 630  A$(T)=T$
  64. 640  PRINT "Any more changes to be made to the menu (Y or N)?"
  65. 650  X$=INKEY$: IF X$="" GOTO 650
  66. 660  IF X$="y" OR X$="Y" THEN CLS:PRINT S$:GOSUB 730:GOTO 580
  67. 670  IF X$="N" OR X$="n" THEN GOTO 680 ELSE GOTO 650
  68. 680  GOSUB 690:GOTO 360 ' Go clear the screen.
  69. 690  OPEN "IQ.SAV" FOR OUTPUT AS #1
  70. 700  FOR I=1 TO 20
  71. 710    WRITE #1,A$(I)
  72. 720  NEXT I:CLOSE #1:RETURN
  73. 730  COLOR 0,7:PRINT "NO. PROGRAM NAME   NO. PROGRAM NAME":COLOR 2,0
  74. 740  FOR I=1 TO 10
  75. 750  COLOR 0,7:PRINT I;:COLOR 2,0:PRINT " " A$(I);:LOCATE ,20:COLOR 0,7:PRINT I+10;:COLOR 2,0:PRINT " " A$(I+10)
  76. 760  NEXT I:RETURN
  77. 770  COLOR 2,0:CLS:PRINT R$:FILES "*.BAS":PRINT R$:COLOR 7,0:LOCATE ,5 'Here if new menu to be generated
  78. 780  PRINT "     Listed above are all of the programs on this diskette that can be inserted into the Program Select Menu - maximum = 20."
  79. 790  PRINT:PRINT "     When prompted, enter the program names you want inserted into the menu for this diskette - leaving OUT the .BAS suffix."
  80. 800  COLOR 6,0:PRINT "     (Press <ENTER> after last entry to exit this routine.)RUNOLOR 7,0:PRINT S$
  81. 810  DEF SEG=&H40:POKE &H17,PEEK(&H17) OR &H40:DEF SEG     'Caps lock ON
  82. 820  FOR I=1 TO 10
  83. 830    PRINT "No.";I;"program is to be - ";:COLOR 2,0:INPUT " ",A$(I):COLOR 7,0
  84. 840    IF LEN(A$(I))>8 THEN A$(I)="*ENTRY ERROR*"
  85. 850    IF LEN(A$(I))=0 THEN GOSUB 690: GOTO 360
  86. 860  NEXT I
  87. 870  FOR J=11 TO 20
  88. 880     LOCATE J+3,38:PRINT "No.";J;"program is to be - ";:COLOR 2,0:INPUT " ",A$(J):COLOR 7,0
  89. 890    IF LEN(A$(J))>8 THEN A$(J)="*ENTRY ERROR*"
  90. 900    IF LEN(A$(J))=0 THEN GOSUB 690: GOTO 360
  91. 910  NEXT J
  92. 920  PRINT S$
  93. 930  GOSUB 690: GOTO 360
  94. 940      'Error routine
  95. 950  IF ERR=53 AND ERL=320 THEN GOTO 990'First entry - IQ.SAV not on disk
  96. 960  IF ERR=53 AND ERL=530 THEN GOTO 1000  'Program not on disk - keying error??
  97. 970  ON ERROR GOTO 0                     'Stop error trapping
  98. 980  RESUME                              'Return to line causing other error
  99. 990  RESUME 770
  100. 1000  RESUME 540
  101. 1010  END
  102.